home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MISC.SWG / 0087_Fuzzy logic unit (German).pas < prev    next >
Pascal/Delphi Source File  |  1994-02-03  |  20KB  |  575 lines
  1. {
  2. ---------------------------------------------------------------------------
  3. KW>WV>Got some german pascal code on this subject. It seems to implement a
  4.   >  >.... (Bit large to send if nobody's interested).
  5.  
  6. KW>Can you extract the specifically fuzzy logic parts?
  7.   >---
  8. No (didnt know where to look, how doesfuzzy pascal look :-) ) so here's
  9. the complete program taken from a german magazine
  10. }
  11.  
  12. UNIT Fuzzy;
  13. INTERFACE
  14.  
  15. Uses Graph,Crt,Dos;
  16.  
  17. CONST
  18.   Infinity  = 1.7e38;
  19.   NoRules   = NIL;
  20.   ValueCol  = LightMagenta;
  21.  
  22. TYPE
  23.   NameStr       = String[20];
  24.   (* verschiedene Operatortypen *)
  25.   Inference     = FUNCTION(Set1,Set2,Set3:Real):real;
  26.  
  27.   FuzzySetList  = ^FuzzySet;
  28.   FuzzyVarList  = ^FuzzyVar;
  29.   FuzzyRuleList = ^FuzzyRule;
  30.  
  31.   FuzzySet      = Object
  32.                     SetName : NameStr;       (* Mengenbenzeichner    *)
  33.                     StartAt,                 (* Startwert            *)
  34.                     HighAt,                  (* Maximum bei ...      *)
  35.                     EndAt   : Real;          (* Endwert              *)
  36.                     Next    : FuzzySetList;
  37.                     Color   : Byte;
  38.                     MemberShip : Real;       (* aktueller Wert der   *)
  39.                                              (* Zugehörigkeit        *)
  40.                     Rules   : FuzzyRuleList; (* Regelliste für diese *)
  41.                                              (* unscharfe Menge      *)
  42.                     Constructor Init( InitName : NameStr;
  43.                                       InitStart, InitHigh,
  44.                                       InitEnd  : Real;
  45.                                       InitColor: Byte);
  46.                     PROCEDURE Append( InitName : NameStr;
  47.                                       InitStart, InitHigh,
  48.                                       InitEnd  : Real;
  49.                                       InitColor: Byte);
  50.                     FUNCTION  GetMemberShip(LingVal : Real):Real;
  51.                     PROCEDURE DefineRule( InfType : Inference;
  52.                                           Var1    : FuzzyVarList;
  53.                                           SetName1: NameStr;
  54.                                           Var2    : FuzzyVarList;
  55.                                           SetName2: NameStr);
  56.                   END;
  57.  
  58.   FuzzyVar        = Object
  59.                     VarName   : NameStr;       (* Variablenname        *)
  60.                     PosX,PosY : WORD;          (* Bildschirmkoordinaten*)
  61.                     StartValue,                (* Anfang und Ende des  *)
  62.                     EndValue,                  (* Koordinatensystems   *)
  63.                     Scale     : Real;          (* Maßstabsfaktor       *)
  64.                     UnitStr   : NameStr;       (* Einheit, z.B. °C     *)
  65.                     CurrentVal: Real;          (* aktueller Wert       *)
  66.                     FuzzySets : FuzzySetList;  (* Liste der unscharfen *)
  67.                                                (* Mengen               *)
  68.                     Result,BackGround :
  69.                        ARRAY[1..5] OF PointType;
  70.                     Constructor Init( InitName    : NameStr;
  71.                                       InitX,InitY : WORD;
  72.                                       Sections    : Byte;
  73.                                       InitStart,InitEnd,
  74.                                       InitValue   : Real;
  75.                                       InitUnit    : NameStr);
  76.                     PROCEDURE  CoordSystem(Sections : Byte);
  77.                     FUNCTION   RealToCoord(r:Real):WORD;
  78.                     PROCEDURE  DisplaySets;
  79.                     PROCEDURE  DisplayValue(TextColor:WORD);
  80.                     PROCEDURE  DisplayResultSets;
  81.                     PROCEDURE  Change(Diff : Real);
  82.                     FUNCTION   GetMemberShipOf(Name : NameStr):Real;
  83.                     PROCEDURE  Infer;
  84.                     PROCEDURE  DeFuzzy;
  85.                     PROCEDURE  DefineSet( InitName : NameStr;
  86.                                           InitStart, InitHigh,
  87.                                           InitEnd  : Real;
  88.                                           InitColor: Byte);
  89.                     PROCEDURE  DefineRule(SetName  : NameStr;
  90.                                           InfType  : Inference;
  91.                                           Var1     : FuzzyVarList;
  92.                                           SetName1 : NameStr;
  93.                                           Var2     : FuzzyVarList;
  94.                                           SetName2 : NameStr);
  95.                   END;
  96.  
  97.   FuzzyRule       = Object
  98.                     Inf_Type   : Inference;       (* Operatortyp       *)
  99.                     Var1, Var2 : FuzzyVarList;    (* Eingangsvariablen *)
  100.                     SetName1, SetName2 : NameStr; (* Eingangsmengen    *)
  101.                     Next       : FuzzyRuleList;
  102.                     Constructor Init( InitInf    : Inference;
  103.                                       InitVar1   : FuzzyVarList;
  104.                                       InitName1  : NameStr;
  105.                                       InitVar2   : FuzzyVarList;
  106.                                       InitName2  : NameStr);
  107.                     PROCEDURE Append( InitInf    : Inference;
  108.                                       InitVar1   : FuzzyVarList;
  109.                                       InitName1  : NameStr;
  110.                                       InitVar2   : FuzzyVarList;
  111.                                       InitName2  : NameStr);
  112.                     FUNCTION Infer(HomeSetValue:Real):Real;
  113.                   END;
  114.  
  115. Procedure Buzz;
  116. procedure error(message : string);
  117.  
  118. function Max( A, B: Real ): Real;
  119. function Min( A, B: Real ): Real;
  120.  
  121. FUNCTION AND_MaxMin(Set1,Set2,Set3:Real):Real;
  122. FUNCTION OR_MaxMax(Set1,Set2,Set3:Real):Real;
  123.  
  124. VAR
  125.   DisplayOn : BOOLEAN; (* Anzeige der unscharfen Mengen ein/aus *)
  126.   Regs : Registers;
  127.   ResultCol : WORD;
  128.  
  129. Implementation
  130.  
  131. CONST OffSet = 20;
  132.  
  133. VAR   Buffer : String;
  134.  
  135. PROCEDURE Buzz;
  136. BEGIN sound(30); Delay(100); NoSound; END;
  137.  
  138. procedure error(message : string);
  139. begin
  140.   CloseGraph; writeln(message); halt
  141. end;
  142.  
  143. function Max( A, B: Real ): Real;
  144. begin
  145.   if A < B then Max := B else Max := A;
  146. end;
  147.  
  148. function Min( A, B: Real ): Real;
  149. begin
  150.   if A > B then Min := B else Min := A;
  151. end;
  152.  
  153. (* MaxMin-Operator für UND *)
  154. FUNCTION AND_MaxMin(Set1,Set2,Set3:Real):Real;
  155. BEGIN
  156.   AND_MaxMin:=Max(Set1,Min(Set2,Set3))
  157. END;
  158.  
  159. (* MaxMax-Operator für ODER *)
  160. FUNCTION OR_MaxMax(Set1,Set2,Set3:Real):Real;
  161. BEGIN
  162.   OR_MaxMax:=Max(Set1,Max(Set2,Set3))
  163. END;
  164.  
  165. CONSTRUCTOR FuzzySet.Init;
  166.  
  167. BEGIN
  168.   SetName := InitName;
  169.   StartAt := InitStart;
  170.   HighAt  := InitHigh;
  171.   EndAt   := InitEnd;
  172.   Color   := InitColor;
  173.   Next    := NIL;
  174.   Rules:= NoRules;
  175.   MemberShip := 0;
  176. END;
  177.  
  178. PROCEDURE FuzzySet.Append;
  179. BEGIN
  180.   IF Next=NIL
  181.   THEN New(Next,Init(InitName,InitStart,InitHigh,InitEnd,InitColor))
  182.   ELSE Next^.Append(InitName,InitStart,InitHigh,InitEnd,InitColor)
  183. END;
  184.  
  185. FUNCTION FuzzySet.GetMemberShip;
  186. BEGIN
  187.   IF (LingVal<=StartAt) THEN GetMemberShip:=0
  188.   ELSE IF (LingVal>=EndAt) THEN GetMemberShip:=0
  189.   ELSE
  190.   BEGIN
  191.     IF ((StartAt=-Infinity) AND (LingVal<=HighAt))
  192.     OR ((EndAt=Infinity) AND (LingVal>=HighAt)) THEN GetMemberShip:=1
  193.     ELSE IF (LingVal<=HighAt)
  194.          THEN GetMemberShip:=(LingVal-StartAt)/(HighAt-StartAt)
  195.     ELSE GetMemberShip:=1-(LingVal-HighAt)/(EndAt-HighAt)
  196.   END
  197. END;
  198.  
  199. PROCEDURE FuzzySet.DefineRule;
  200. BEGIN
  201.   IF Rules=NoRules THEN
  202.      Rules:= new(FuzzyRuleList,
  203.              Init(InfType,Var1,SetName1,Var2,SetName2))
  204.   ELSE Rules^.Append(InfType,Var1,SetName1,Var2,SetName2)
  205. END;
  206.  
  207. CONSTRUCTOR FuzzyVar.Init;
  208. BEGIN
  209.   VarName:=InitName;
  210.   PosX:=InitX;
  211.   PosY:=InitY;
  212.   StartValue:=InitStart;
  213.   EndValue  :=InitEnd;
  214.   Scale     :=210/(EndValue-StartValue);
  215.   UnitStr   :=InitUnit;
  216.   CurrentVal:=InitValue;
  217.   CoordSystem(Sections);
  218.   FuzzySets      :=NIL;
  219.   BackGround[1].x:=PosX+1;   BackGround[1].y:=PosY+100;
  220.   BackGround[2].x:=PosX+1;   BackGround[2].y:=PosY+20;
  221.   BackGround[3].x:=PosX+250; BackGround[3].y:=PosY+20;
  222.   BackGround[4].x:=PosX+250; BackGround[4].y:=PosY+100;
  223.   BackGround[5]:=BackGround[1];
  224. END;
  225.  
  226. FUNCTION FuzzyVar.RealToCoord(r:Real):WORD;
  227. BEGIN
  228.   RealToCoord:=PosX+OffSet+Round((r-StartValue)*Scale);
  229. END;
  230.  
  231. PROCEDURE FuzzyVar.CoordSystem(Sections: BYTE);
  232. (* zeichnet ein Koordinatensystem            *)
  233. (* PosX, PosY bestimmen die linke obere Ecke *)
  234. VAR N         : Byte;
  235.     MarkerX   : WORD;
  236.     Increment : Real;
  237. BEGIN
  238.   SetColor(White);
  239.   SetTextJustify(CenterText,CenterText);
  240.   Line( PosX, PosY, PosX, PosY+103 );
  241.   Line( PosX-3, PosY+100, PosX+250, PosY+100 );
  242.   Line( PosX, PosY+20, PosX-3, PosY+20 );
  243.   OutTextXY( PosX-15, PosY+20,  '1' );
  244.   OutTextXY( PosX-15, PosY+100, '0' );
  245.   Increment :=(EndValue-StartValue)/(Sections-1);
  246.   for N := 0 to Sections-1 do
  247.   begin
  248.     MarkerX:=RealToCoord(StartValue+N*Increment);
  249.     Line(MarkerX,PosY+101,MarkerX,PosY+103);
  250.     Str(Round(StartValue + N * Increment), Buffer );
  251.     OutTextXY(MarkerX, PosY+113, Buffer );
  252.   end;
  253.   OutTextXY( PosX + 270, PosY + 113, '['+UnitStr+']');
  254.   SetColor(Red);
  255.   SetTextJustify(LeftText,CenterText);
  256.   OutTextXY( PosX + 20, PosY + 140,VarName+' = ');
  257.   OutTextXY( PosX + 200,PosY + 140,UnitStr);
  258. END;
  259.  
  260. PROCEDURE FuzzyVar.DisplayValue;
  261.  
  262. BEGIN
  263.   SetWriteMode(XORPut);
  264.   SetColor(ValueCol);
  265.   IF (CurrentVal>=StartValue) AND (CurrentVal<=EndValue)
  266.   THEN Line(RealToCoord(CurrentVal),PosY+20,
  267.        RealToCoord(CurrentVal),PosY+100);
  268.   SetColor(TextColor);
  269.   SetTextJustify(RightText,CenterText);
  270.   Str(CurrentVal : 7 : 2, Buffer );
  271.   OutTextXY( PosX+190, PosY + 140 , Buffer );
  272. END;
  273.  
  274. PROCEDURE FuzzyVar.Change;
  275. BEGIN
  276.   IF (CurrentVal+Diff>=StartValue) AND (CurrentVal+Diff<=EndValue)
  277.   THEN
  278.   BEGIN
  279.     DisplayValue(0);
  280.     CurrentVal:=CurrentVal+Diff;
  281.     DisplayValue(ValueCol);
  282.   END
  283.   ELSE (* Bereichsgrenzen überschritten *)
  284.   Buzz;
  285. END;
  286.  
  287. PROCEDURE FuzzyVar.DisplaySets;
  288. (* zeigt die unscharfen Mengen einer Variablen an *)
  289. VAR SetPtr : FuzzySetList;
  290. BEGIN
  291.   SetPtr:=FuzzySets;
  292.   WHILE SetPtr<>NIL DO WITH SetPtr^ DO
  293.   BEGIN
  294.     SetColor(Color);
  295.     IF StartAt=-Infinity THEN SetTextJustify(RightText,CenterText)
  296.     ELSE IF EndAt=Infinity THEN SetTextJustify(LeftText,CenterText)
  297.     ELSE SetTextJustify(CenterText,CenterText);
  298.     OutTextXY(RealToCoord(HighAt),PosY+10,SetName);
  299.     IF StartAt=-Infinity
  300.     THEN Line(PosX,PosY+20,RealToCoord(HighAt),PosY+20)
  301.     ELSE Line( RealToCoord(StartAt),PosY+100,
  302.                RealToCoord(HighAt),PosY+20);
  303.     IF EndAt=Infinity
  304.     THEN Line(RealToCoord(HighAt),PosY+20,PosX+250,PosY+20)
  305.     ELSE Line(RealToCoord(HighAt),PosY+20,RealToCoord(EndAt),PosY+100);
  306.     SetPtr:=Next
  307.   END
  308. END;
  309.  
  310. FUNCTION FuzzyVar.GetMemberShipOf;
  311. VAR SetPtr : FuzzySetList;
  312. BEGIN
  313.   SetPtr:=FuzzySets;
  314.   WHILE (SetPtr<>NIL) AND (SetPtr^.SetName<>Name) DO SetPtr:=SetPtr^.Next;
  315.   IF SetPtr=NIL THEN error( 'Menge '+Name+' ist in der Ling. Variablen '
  316.                             +VarName+' nicht definiert!')
  317.   ELSE GetMemberShipOf:=SetPtr^.GetMemberShip(CurrentVal)
  318. END;
  319.  
  320. PROCEDURE  FuzzyVar.DisplayResultSets;
  321. VAR SetPtr : FuzzySetList;
  322. BEGIN
  323.   SetWriteMode(CopyPut);
  324.   SetColor(ResultCol);
  325.   SetPtr:=FuzzySets;
  326.   WHILE SetPtr<>NIL DO WITH SetPtr^ DO
  327.   BEGIN
  328.     IF MemberShip>0 THEN
  329.     BEGIN
  330.       IF StartAt<=StartValue THEN Result[1].x := RealToCoord(StartValue)
  331.       ELSE Result[1].x := RealToCoord(StartAt);
  332.       Result[1].y := PosY+99;
  333.       Result[2].x := RealToCoord(HighAt);
  334.       Result[2].y := PosY+99 - Round(MemberShip*79);
  335.       IF EndAt>=EndValue THEN Result[3].x := RealToCoord(EndValue)
  336.       ELSE Result[3].x:= RealToCoord(EndAt);
  337.       Result[3].y := PosY+99;
  338.       Result[4]   := Result[1];
  339.       FillPoly( 4, Result )
  340.     END;
  341.     SetPtr:=next
  342.   END
  343. END;
  344.  
  345. PROCEDURE FuzzyVar.Infer; (* alle Regeln antriggern *)
  346. VAR
  347.   SetPtr : FuzzySetList;
  348.   RulePtr: FuzzyRuleList;
  349. BEGIN
  350.   SetPtr:=FuzzySets;
  351.   WHILE SetPtr<>NIL DO WITH SetPtr^ DO
  352.   BEGIN
  353.     RulePtr:=Rules;
  354.     MemberShip:=0;
  355.     WHILE RulePtr<>NIL DO
  356.     BEGIN
  357.       MemberShip:=RulePtr^.Infer(MemberShip);
  358.       RulePtr:=RulePtr^.Next
  359.     END;
  360.     SetPtr:=Next
  361.   END
  362. END; (* FuzzyVar.Infer *)
  363.  
  364. PROCEDURE FuzzyVar.Defuzzy;
  365. (* Bestimmung des Flächenschwerpunktes der unscharfen *)
  366. (* Ergebnismenge durch Auszählen der Pixel            *)
  367.  
  368. (* Raster der Rechnergeschwindigkeit anpassen *)
  369. (* größte Rechengenauigkeit bei Raster=1      *)
  370. CONST Raster = 16;
  371. VAR
  372.   X,Y,XOffSet : WORD;
  373.   Zaehler, Nenner: Real;
  374. BEGIN
  375.   DisplayValue(Black);
  376.   SetFillStyle(SolidFill, Black);
  377.   SetColor(Black);
  378.   FillPoly(5, BackGround);
  379.   SetFillStyle(SolidFill, ResultCol);
  380.   IF DisplayOn
  381.   THEN DisplaySets; (* verzerrt das Ergebnis auf Hercules *)
  382.   DisplayResultSets;
  383.   Zaehler :=0;
  384.   Nenner :=0;
  385.   XOffset :=PosX+20;
  386.   for X := 0 TO 210 DIV Raster DO (* Flächenschwerpunkt bestimmen *)
  387.    for Y := PosY + 20 to PosY + 100 do
  388.    if GetPixel(Raster*X+XOffSet,Y) = ResultCol then
  389.    begin
  390.      Nenner:=Nenner+1;
  391.      Zaehler:=Zaehler+Raster*X;
  392.    end;
  393.   IF Nenner=0 THEN CurrentVal:=0
  394.   ELSE CurrentVal :=Zaehler/Nenner/Scale+StartValue;
  395.   DisplayValue(ResultCol)
  396. end;
  397.  
  398. PROCEDURE FuzzyVar.DefineRule;
  399. VAR SetPtr : FuzzySetList;
  400. BEGIN
  401.   SetPtr:=FuzzySets;
  402.   WHILE (SetPtr<>NIL) AND (SetPtr^.SetName<>SetName)
  403.   DO SetPtr:=SetPtr^.Next;
  404.   IF SetPtr=NIL THEN error( 'Menge '+SetName+' ist in der Ling. '+
  405.                             'Variablen '+VarName+' nicht definiert!')
  406.   ELSE SetPtr^.DefineRule(InfType,Var1,SetName1,Var2,SetName2)
  407. END;
  408.  
  409. PROCEDURE FuzzyVar.DefineSet;
  410. BEGIN
  411.   IF FuzzySets = NIL
  412.   THEN FuzzySets:= new(FuzzySetList,
  413.                    Init(InitName,InitStart,InitHigh,InitEnd,InitColor))
  414.   ELSE FuzzySets^.Append(InitName,InitStart,InitHigh,InitEnd,InitColor)
  415. END;
  416.  
  417. CONSTRUCTOR FuzzyRule.Init;
  418. BEGIN
  419.   Inf_Type :=InitInf;
  420.   Var1     :=InitVar1;
  421.   Var2     :=InitVar2;
  422.   SetName1 :=InitName1;
  423.   SetName2 :=InitName2;
  424.   Next     :=NIL
  425. END;
  426.  
  427. PROCEDURE FuzzyRule.Append;
  428. BEGIN
  429.   IF Next=NIL
  430.   THEN New(Next,Init(InitInf,InitVar1,InitName1,InitVar1,InitName2))
  431.   ELSE Next^.Append(InitInf,InitVar1,InitName1,InitVar2,InitName2)
  432. END;
  433.  
  434. FUNCTION FuzzyRule.Infer; (* einzelne Regel abarbeiten *)
  435. BEGIN
  436.   Infer:=Inf_Type(HomeSetValue, Var1^.GetMemberShipOf(SetName1),
  437.                                 Var2^.GetMemberShipOf(SetName2));
  438. END;
  439.  
  440. BEGIN (* Fuzzy-Logic-Unit *)
  441.   (* Test auf Herculeskarte wg. Farbe für Ergebnismengen *)
  442.   Regs.ah:=15;
  443.   Intr($10,Regs);
  444.   IF Regs.AL=7 THEN (* Hercules-Karte *)
  445.   BEGIN
  446.     ResultCol :=Blue;
  447.     DisplayOn :=FALSE; (* siehe Artikel c't 3/91 *)
  448.   END
  449.   ELSE (* EGA-/VGA-Karte *)
  450.   BEGIN
  451.     ResultCol :=LightGray;
  452.     DisplayOn :=TRUE
  453.   END
  454. END.
  455.  
  456. { --------------------------    DEMO PROGRAM   ------------------------ }
  457. {             I HOPE THAT YOU CAN READ GERMAN !!                        }
  458.  
  459. program fuzzy_inf_demo; (* c't 3/91 / it / C.v.Altrock, RWTH Aachen *)
  460. uses Graph, Crt, Fuzzy;
  461. type InputType = (temp,press,valve);
  462. var
  463.   GraphDriver, GraphMode, RK : Integer;
  464.   StepWidth     : Array[InputType] OF Real;
  465.   i,Input       : InputType;
  466.   Ch            : Char;
  467.   FuzzyVars     : ARRAY[InputType] of FuzzyVarList;
  468.  
  469. PROCEDURE InitGrafix;
  470. (* Grafikmodus initialisieren und Hilfetexte schreiben *)
  471. BEGIN
  472.   GraphDriver := Detect;
  473.   InitGraph(GraphDriver,GraphMode,'\turbo\tp');
  474.   SetTextJustify(CenterText,CenterText);
  475.   OutTextXY( GetMaxX DIV 2, 10, 'Demonstration der MAX-PROD-'
  476.              +'Inferenz (c''t 3/91 / C.v.Altrock, RWTH Aachen)');
  477.   OutTextXY( 500, 50, 'Eingabe Temperatur: ['+Chr(24)+']' );
  478.   OutTextXY( 500, 65, 'Eingabe Druck: ['+Chr(25)+']' );
  479.   OutTextXY( 500, 80, 'Erhöhen: ['+Chr(26)+']' );
  480.   OutTextXY( 500, 95, 'Vermindern: ['+Chr(27)+']' );
  481.   OutTextXY( 500, 110, 'Schrittweite: [Bild'+Chr(24)+Chr(25)+']' );
  482.   Rectangle(400,40,600,120);
  483. END; (* InitGrafix *)
  484.  
  485. begin (* main *)
  486.   InitGrafix;
  487.  
  488.   (* Definition der linguistischen Variablen "Temperatur" *)
  489.   FuzzyVars[temp]:= new(FuzzyVarList,
  490.                     Init('Temperatur',20,30,7,400,1000,650,'°C'));
  491.   WITH FuzzyVars[temp]^ DO
  492.   BEGIN
  493.     (* Definition und Anzeige der Fuzzy Sets *)
  494.     DefineSet('niedrig',-Infinity,500,650,Blue);
  495.     DefineSet('mittel',500,650,800,LightGreen);
  496.     DefineSet('hoch',650,800,950,Red);
  497.     DefineSet('sehr_hoch',800,950,Infinity,Yellow);
  498.     DisplaySets; DisplayValue(ValueCol);
  499.   END;
  500.  
  501.   (* Definition der linguistischen Variablen "Druck" *)
  502.   FuzzyVars[press]:= new(FuzzyVarList,
  503.                      Init('Druck',20,210,4,38,41,40,'bar'));
  504.   WITH FuzzyVars[press]^ DO
  505.   BEGIN
  506.     (* Definition und Anzeige der Fuzzy Sets *)
  507.     DefineSet('unter_normal',-Infinity,39,40,Blue);
  508.     DefineSet('normal',39,40,41,LightGreen);
  509.     DefineSet('über_normal',40,41,Infinity,Red);
  510.     DisplaySets; DisplayValue(ValueCol);
  511.   END;
  512.  
  513.   (* Definition der linguistischen Variablen "Methanventil" *)
  514.   FuzzyVars[valve]:= new(FuzzyVarList,
  515.                      Init('Methanventil',340,170,7,0,12,0,'m3/h'));
  516.   WITH FuzzyVars[valve]^ DO
  517.   BEGIN
  518.     (* Definition der Fuzzy Sets *)
  519.     DefineSet('gedrosselt',-Infinity,0,4,Blue);
  520.     DefineSet('halboffen',0,4,8,Green);
  521.     DefineSet('mittel',4,8,12,LightGreen);
  522.     DefineSet('offen',8,12,Infinity,Yellow);
  523.     (* Definition der Inferenzregeln *)
  524.     (* 1 IF Temperatur ist niedrig OR Druck ist unter_normal
  525.          THEN Methanventil ist offen                         *)
  526.     DefineRule('offen',OR_MaxMax, FuzzyVars[temp],'niedrig',
  527.                                   FuzzyVars[press],'unter_normal');
  528.     (* 2 IF Temperatur ist sehr_hoch OR Druck ist über_normal
  529.          THEN Methanventil ist gedrosselt                    *)
  530.     DefineRule('gedrosselt',OR_MaxMax, FuzzyVars[temp],'sehr_hoch',
  531.                                        FuzzyVars[press],'über_normal');
  532.     (* 3 IF Temperatur ist hoch AND Druck ist normal
  533.          THEN Methanventil ist halboffen                     *)
  534.     DefineRule('halboffen',AND_MaxMin, FuzzyVars[temp],'hoch',
  535.                                        FuzzyVars[press],'normal');
  536.     (* 4 IF Temperatur ist mittel AND Druck ist normal
  537.          THEN Methanventil ist mittel                        *)
  538.     DefineRule('mittel',AND_MaxMin, FuzzyVars[temp],'mittel',
  539.                                        FuzzyVars[press],'normal');
  540.     IF DisplayOn THEN DisplaySets;
  541.     DisplayValue(ValueCol);
  542.     Infer;
  543.     Defuzzy;
  544.   END;
  545.  
  546.   SetColor( Red );
  547.   OutTextXY( 540, 330, '(Resultat der Inferenz)' );
  548.   (* Schrittweiten für Druck und Temperatur intitialisieren *)
  549.   StepWidth[temp]:=25;
  550.   StepWidth[press]:=0.25;
  551.  
  552.   Input:= temp;
  553.   Ch := ReadKey;
  554.   while Ch = #0 do
  555.   begin
  556.     RK := ord(ReadKey);
  557.     if RK = 72 then input := temp
  558.     else if RK = 80 then input := press
  559.     else if (RK=73) then StepWidth[input]:=StepWidth[input] * 2
  560.     else if (RK=81) then Stepwidth[input]:= StepWidth[input] / 2
  561.     else if (RK=75) OR (RK=77) then
  562.     begin
  563.       (* 1. Eingangsvariable ändern *)
  564.       if (RK=75) then FuzzyVars[Input]^.Change(-StepWidth[input])
  565.       ELSE FuzzyVars[Input]^.Change(StepWidth[input]);
  566.       (* 2. Inferenz durchführen *)
  567.       FuzzyVars[valve]^.Infer;
  568.       (* 3. Ergebnismenge defuzzifizieren *)
  569.       FuzzyVars[valve]^.Defuzzy
  570.     end;
  571.     Ch := ReadKey
  572.   end;
  573.   CloseGraph
  574. end.
  575.